home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Workbench Add-On
/
Workbench Add-On - Volume 1.iso
/
Dev
/
Oberon
/
source
/
Library
/
Strings2.mod
< prev
next >
Wrap
Text File
|
1995-06-29
|
5KB
|
217 lines
(***************************************************************************
$RCSfile: Strings2.mod $
Description: More string manipulation
Created by: fjc (Frank Copeland)
$Revision: 1.5 $
$Author: fjc $
$Date: 1995/06/29 19:04:45 $
Copyright © 1994-1995, Frank Copeland.
This file is part of the Oberon-A Library.
See Oberon-A.doc for conditions of use and distribution.
***************************************************************************)
<*$ IndexChk- *>
(* Index checking is handled explicitly by the relevant procedures. *)
MODULE Strings2;
IMPORT SYS := SYSTEM, Strings;
PROCEDURE Min ( a, b : INTEGER ) : INTEGER;
BEGIN (* Min *)
IF a < b THEN RETURN a
ELSE RETURN b
END
END Min;
PROCEDURE Max ( a, b : INTEGER ) : INTEGER;
BEGIN (* Max *)
IF a > b THEN RETURN a
ELSE RETURN b
END
END Max;
(*------------------------------------*)
PROCEDURE OverWrite *
( source : ARRAY OF CHAR;
pos : INTEGER;
VAR dest : ARRAY OF CHAR );
(*
Overwrites the contents of "dest" with "source", starting at "pos".
Truncates where necessary.
*)
VAR len : INTEGER;
<*$CopyArrays-*>
BEGIN (* OverWrite *)
len := Min (Strings.Length (source), Strings.Length (dest) - pos);
IF len > 0 THEN
SYS.MOVE (SYS.ADR (source), SYS.ADR (dest [pos]), len)
END
END OverWrite;
(*------------------------------------*)
PROCEDURE OverWriteSubString *
( source : ARRAY OF CHAR;
start, len, pos : INTEGER;
VAR dest : ARRAY OF CHAR );
(*
Overwrites the contents of dest [pos ...] with source [start ..
(start + len - 1)]. Truncates or extends where necessary.
*)
VAR len2 : INTEGER;
<*$CopyArrays-*>
BEGIN (* OverWriteSubString *)
len2 :=
Min (Min (len, Strings.Length (source) - start), Strings.Length (dest) - pos );
IF len2 > 0 THEN
SYS.MOVE (SYS.ADR (source), SYS.ADR (dest [pos]), len2)
END
END OverWriteSubString;
(*------------------------------------*)
PROCEDURE FindChar *
( char : CHAR;
str : ARRAY OF CHAR;
pos : INTEGER )
: INTEGER;
(*
Searches "str" for the first occurrence of "char", starting at "pos"
and returns its position if found, otherwise it returns -1.
*)
VAR lim : INTEGER;
<*$CopyArrays-*>
BEGIN (* FindChar *)
lim := Strings.Length (str);
WHILE (pos < lim) & (str [pos] # char) DO
INC(pos);
END;
IF pos = lim THEN RETURN -1 ELSE RETURN pos END
END FindChar;
(*------------------------------------*)
PROCEDURE CompareCAP *
( str1, str2 : ARRAY OF CHAR )
: SHORTINT;
(*
Returns the result of the lexical comparison of the two strings. Returns
-1 if (str1 < str2), 0 if (str1 = str2) and 1 if
(str1 > str2). The case of the strings is ignored.
*)
VAR
len1, len2, index, lim : INTEGER;
result : SHORTINT; ch1, ch2 : CHAR;
<*$CopyArrays-*>
BEGIN (* CompareCAP *)
len1 := Strings.Length (str1); len2 := Strings.Length (str2);
lim := Min (len1, len2); index := 0;
LOOP
IF (index = lim) THEN
IF (len1 < len2) THEN result := -1;
ELSIF (len1 > len2) THEN result := 1;
ELSE result := 0;
END;
EXIT;
END;
ch1 := CAP (str1 [index]); ch2 := CAP (str2 [index]);
IF ch1 < ch2 THEN result := -1; EXIT
ELSIF ch1 > ch2 THEN result := 1; EXIT
END;
INC (index);
END;
RETURN result;
END CompareCAP;
(*------------------------------------*)
PROCEDURE TrimLeft *
( char : CHAR;
VAR str : ARRAY OF CHAR );
(*
Deletes any instances of "char" from the start of "str".
*)
VAR len : INTEGER;
BEGIN (* TrimLeft *)
len := 0; WHILE (str [len] = char) DO INC (len) END;
IF len > 0 THEN Strings.Delete (str, 0, len) END
END TrimLeft;
(*------------------------------------*)
PROCEDURE TrimRight *
( char : CHAR;
VAR str : ARRAY OF CHAR );
(*
Deletes any instances of "char" from the end of "str".
*)
VAR pos : INTEGER;
BEGIN (* TrimRight *)
pos := Strings.Length (str) - 1;
WHILE (str [pos] = char) DO DEC (pos) END;
str [pos] := 0X;
END TrimRight;
(*------------------------------------*)
PROCEDURE Fill *
( char : CHAR;
pos, len : INTEGER;
VAR str : ARRAY OF CHAR );
(*
Fills str with char, beginning at pos character for len
characters.
*)
VAR len2 : INTEGER;
BEGIN (* Fill *)
IF pos < (SHORT (LEN (str)) - 1) THEN
len := Min (len, SHORT (LEN (str)) - pos - 1);
len2 := Max (Strings.Length (str), pos + len);
WHILE len > 0 DO
str [pos] := char; INC (pos); DEC (len)
END; (* WHILE *)
str [len2] := 0X;
END
END Fill;
(*------------------------------------*)
PROCEDURE ToLower *
(VAR str : ARRAY OF CHAR);
VAR index : INTEGER; ch : CHAR;
BEGIN (* ToLower *)
index := 0; ch := str [0];
WHILE ch # 0X DO
IF ((ch >= "A") & (ch <= "Z")) OR ((ch >= "À") & (ch <= "ß")) THEN
ch := CHR (ORD (ch) + 32); str [index] := ch
END;
INC (index); ch := str [index]
END;
END ToLower;
END Strings2.